home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Peter Stone Punctus / J.S.Bach Variant < prev    next >
Lisp/Scheme  |  1998-10-27  |  7KB  |  248 lines
  1. ; Here is some fun we did with Janusz Podrazik in Dec 1996 when improvising 
  2. ; together, starting with the J.S.Bach Praeludium I as a source and turning it
  3. ; into something else. Piano sound was used.
  4.  
  5. ; Appendix A 'Ample'
  6.  
  7. ; J.S.Bach Wohltemperierters Klavier, Erste Teil, Praeludium I. 
  8.  
  9. (setq rh
  10.       '(([ 1/8 = 1/16 g4 c5 e5 g4 c5 e5 ])
  11.         ([ 1/8 = 1/16 a4 d5 f5 a4 d5 f5 ])
  12.         ([ 1/8 = 1/16 g4 d5 f5 g4 d5 f5 ])
  13.         ([ 1/8 = 1/16 g4 c5 e5 g4 c5 e5 ])
  14.         ([ 1/8 = 1/16 a4 e5 a5 a4 e5 a5 ])     ;  5
  15.         ([ 1/8 = 1/16 f#4 a4 d5 f#4 a4 d5 ])
  16.         ([ 1/8 = 1/16 g4 d5 g5 g4 d5 g5 ])
  17.         ([ 1/8 = 1/16 e4 g4 c5 e4 g4 c5 ])
  18.         ([ 1/8 = 1/16 e4 g4 c5 e4 g4 c5 ])
  19.         ([ 1/8 = 1/16 d4 f#4 c5 d4 f#4 c5 ])   ; 10
  20.         ([ 1/8 = 1/16 d4 g4 b4 d4 g4 b4 ])
  21.         ([ 1/8 = 1/16 e4 g4 c#5 e4 g4 c#5 ])
  22.         ([ 1/8 = 1/16 d4 a4 d5 d4 a4 d5 ])
  23.         ([ 1/8 = 1/16 d4 f4 b4 d4 f4 b4 ])
  24.         ([ 1/8 = 1/16 c4 g4 c5 c4 g4 c5 ])     ; 15
  25.         ([ 1/8 = 1/16 a3 c4 f4 a3 c4 f4 ])
  26.         ([ 1/8 = 1/16 a3 c4 f4 a3 c4 f4 ])
  27.         ([ 1/8 = 1/16 g3 b3 f4 g3 b3 f4 ])
  28.         ([ 1/8 = 1/16 g3 c4 e4 g3 c4 e4 ])
  29.         ([ 1/8 = 1/16 b&3 c4 e4 b&3 c4 e4 ])   ; 20
  30.         ([ 1/8 = 1/16 a3 c4 e4 a3 c4 e4 ])
  31.         ([ 1/8 = 1/16 a3 c4 e&4 a3 c4 e&4 ])
  32.         ([ 1/8 = 1/16 b3 c4 d4 b3 c4 d4 ])
  33.         ([ 1/8 = 1/16 g3 b3 d4 g3 b3 d4 ])
  34.         ([ 1/8 = 1/16 g3 c4 e4 g3 c4 e4 ])     ; 25
  35.         ([ 1/8 = 1/16 g3 c4 f4 g3 c4 f4 ])
  36.         ([ 1/8 = 1/16 g3 b3 f4 g3 b3 f4 ])
  37.         ([ 1/8 = 1/16 a3 c4 f#4 a3 c4 f#4 ])
  38.         ([ 1/8 = 1/16 g3 c4 g4 g3 c4 g4 ])
  39.         ([ 1/8 = 1/16 g3 c4 f4 g3 c4 f4 ])     ; 30
  40.         ([ 1/8 = 1/16 g3 b3 f4 g3 b3 f4 ])
  41.         ([ 1/8 = 1/16 g3 b&3 e4 g3 b&3 e4 ])
  42.         (1/8 = 1/16 f3 a3 c4 f4 c4 a3 c4 a3 f3 a3 f3 d3 f3 d3)
  43.         (1/8 = 1/16 g4 b4 d5 f5 d5 b4 d5 b4 g4 b4 d4 f4 e4 d4)
  44.         (1/1 e4_g4_c5))   ; 35
  45.       lh1
  46.       '(([ 1/16 = 7/16 e4 ])
  47.         ([ 1/16 = 7/16 d4 ])
  48.         ([ 1/16 = 7/16 d4 ])
  49.         ([ 1/16 = 7/16 e4 ])
  50.         ([ 1/16 = 7/16 e4 ])    ;  5
  51.         ([ 1/16 = 7/16 d4 ])
  52.         ([ 1/16 = 7/16 d4 ])
  53.         ([ 1/16 = 7/16 c4 ])
  54.         ([ 1/16 = 7/16 c4 ])
  55.         ([ 1/16 = 7/16 a3 ])    ; 10
  56.         ([ 1/16 = 7/16 b3 ])
  57.         ([ 1/16 = 7/16 b&3 ])
  58.         ([ 1/16 = 7/16 a3 ])
  59.         ([ 1/16 = 7/16 a&3 ])
  60.         ([ 1/16 = 7/16 g3 ])    ; 15
  61.         ([ 1/16 = 7/16 f3 ])
  62.         ([ 1/16 = 7/16 f3 ])
  63.         ([ 1/16 = 7/16 d3 ])
  64.         ([ 1/16 = 7/16 e3 ])
  65.         ([ 1/16 = 7/16 g3 ])    ; 20
  66.         ([ 1/16 = 7/16 f3 ])
  67.         ([ 1/16 = 7/16 c3 ])
  68.         ([ 1/16 = 7/16 f3 ])
  69.         ([ 1/16 = 7/16 f3 ])
  70.         ([ 1/16 = 7/16 e3 ])    ; 25
  71.         ([ 1/16 = 7/16 d3 ])
  72.         ([ 1/16 = 7/16 d3 ])
  73.         ([ 1/16 = 7/16 e&3 ])
  74.         ([ 1/16 = 7/16 e3 ])
  75.         ([ 1/16 = 7/16 d3 ])    ; 30
  76.         ([ 1/16 = 7/16 d3 ])
  77.         ([ 1/16 = 7/16 c3 ])
  78.         (1/16 = 15/16 c3)
  79.         (1/16 = 15/16 b2)
  80.         (1/1 c3))               ; 35
  81.       lh2
  82.       '((1/2 c4 c4)
  83.         (1/2 c4 c4)
  84.         (1/2 b3 b3)
  85.         (1/2 c4 c4)
  86.         (1/2 c4 c4)     ;  5
  87.         (1/2 c4 c4)
  88.         (1/2 b3 b3)
  89.         (1/2 b3 b3)
  90.         (1/2 a3 a3)
  91.         (1/2 d3 d3)     ; 10
  92.         (1/2 g3 g3)
  93.         (1/2 g3 g3)
  94.         (1/2 f3 f3)
  95.         (1/2 f3 f3)
  96.         (1/2 e3 e3)     ; 15
  97.         (1/2 e3 e3)
  98.         (1/2 d3 d3)
  99.         (1/2 g2 g2)
  100.         (1/2 c3 c3)
  101.         (1/2 c3 c3)     ; 20
  102.         (1/2 f2 f2)
  103.         (1/2 f#2 f#2)
  104.         (1/2 a&2 a&2)
  105.         (1/2 g2 g2)
  106.         (1/2 g2 g2)     ; 25
  107.         (1/2 g2 g2)
  108.         (1/2 g2 g2)
  109.         (1/2 g2 g2)
  110.         (1/2 g2 g2)
  111.         (1/2 g2 g2)     ; 30
  112.         (1/2 g2 g2)
  113.         (1/2 c2 c2)
  114.         (1/1 c2)
  115.         (1/1 c2)
  116.         (1/1 c2)))      ; 35
  117.  
  118. (setq
  119.  velocity-lh
  120.  (append
  121.   (mapcar (function (lambda (x y)
  122.                       (symbol-transpose x y))) (gen-cresc-dim 0 6 11)
  123.           (gen-repeat 11 (list (gen-repeat 4 '(48 47 52)))))
  124.   (mapcar (function (lambda (x y)
  125.                       (symbol-transpose x y))) (gen-dim 0 -8 4)
  126.           (gen-repeat 4 (list (gen-repeat 4 '(48 47 52)))))
  127.   (mapcar (function (lambda (x y)
  128.                       (symbol-transpose x y))) (gen-dim 0 -12 9)
  129.           (gen-repeat 9 (list (gen-repeat 4 '(46 46 49)))))
  130.   (mapcar (function (lambda (x y)
  131.                       (symbol-transpose x y))) (gen-cresc 0 23 5)
  132.           (gen-repeat 5 (list (gen-repeat 4 '(42 42 44)))))
  133.   (mapcar (function (lambda (x y)
  134.                       (symbol-transpose x y))) (gen-dim 25 0 3)
  135.           (gen-repeat 3 (list (gen-repeat 4 '(43 43 44)))))
  136.   (gen-repeat 2  (list (gen-repeat 4 '(44 44 44))))
  137.   '((48)))
  138.  
  139.  velocity-rh1
  140.  (mapcar 'list
  141.          (append
  142.           (gen-cresc-dim 54 60 15)
  143.           (gen-dim 54 44 9)
  144.           (gen-cresc 54 74 5)
  145.           (gen-dim 71 44 5)
  146.           '(48)))
  147.  
  148.  velocity-rh2
  149.  (mapcar 'list
  150.          (append
  151.           (gen-cresc-dim 52 58 15)
  152.           (gen-dim 52 45 9)
  153.           (gen-cresc 54 74 5)
  154.           (gen-dim 69 44 5)
  155.           '(48))))
  156.  
  157. (setq
  158.  tempo-value
  159.  (flatten
  160.   (list
  161.    (gen-repeat 15 '(61))
  162.    (gen-repeat 15 '(60))
  163.    (gen-repeat 2 '(58))
  164.    (gen-repeat 1 '(56))
  165.    (gen-repeat 12 '(55))
  166.    (gen-dim 45 20 4)
  167.    '50))
  168.  
  169.  tempo
  170.  (flatten
  171.   (list
  172.    (gen-repeat 33 '(1/1))
  173.    (gen-repeat 16 '(1/16))
  174.    '1/1)))
  175.  
  176. ;    --------------- SCORE
  177.  
  178. (setq op.31-Var-für-Orch '(1 7 9 6 8 0 5 4 10 11 2 3))
  179. (setq interval-list (get-interval :all op.31-Var-für-Orch))
  180. (setq interval-lists (rotate-fc 10 interval-list))
  181.  
  182. (def-symbol
  183.   rhand (s-subtract 0.25 '(r r c r r) '(2 3 2 1 2) '(2 3 4 2 2)
  184.                     (g-cluster 0.34 'r 0 0 0 6))
  185.   lhand1 (ambitus :invert
  186.                   -10 10 (i-process 1 -5 43 
  187.                                     (g-chord 0.25 1 4 0 0 interval-lists)))
  188.   lhand2 '((a)))
  189.  
  190. (def-length
  191.   rhand (ample :length rh)
  192.   lhand1 (ample :length lh1)
  193.   lhand2 (ample :length lh2))
  194.  
  195. (def-velocity
  196.   rhand velocity-lh
  197.   lhand1 velocity-rh1
  198.   lhand2 velocity-rh2)
  199.  
  200. (def-duration
  201.   rhand (append
  202.          (p-replace-section
  203.           nil '(3 6 10 13) '1/128
  204.           (gen-repeat 4 (g-integer 1 15))
  205.           (subseq (length-of rhand) 0 15))
  206.          (p-replace-section
  207.           nil '(3 6 10 13) '1/64
  208.           (gen-repeat 4 (g-integer 1 14))
  209.           (subseq (length-of rhand) 15 29))
  210.          (subseq (length-of rhand) 29 35))
  211.   lhand1 (length-of lhand1)
  212.   lhand2 (length-of lhand2))
  213.  
  214. (defun make-random-zones (n seed)
  215.   (let (collect)
  216.     (init-rnd seed)
  217.     (dotimes (i n)
  218.       (push (pick-random '(2/1 1/1 1/2 1/4) nil) collect))
  219.     collect))
  220.  
  221. (def-zone
  222.   tempo tempo
  223.   default (make-random-zones 32 0.123)
  224. )
  225.  
  226. (def-channel
  227.   rhand 1
  228.   lhand1 2
  229.   lhand2 3
  230. )
  231.  
  232. (def-tonality
  233.    default
  234.      (fold-tonality 'a 5 (symbols-to-tonality
  235.                             symbols '(a b c d e f g h -b -c -d)
  236.                             transpose '((0 2 4 6) (2 4 0 6))
  237.                             mapping (activate-tonality (messiaen3 c 5))))
  238. )
  239.  
  240. (def-tempo tempo-value)
  241.  
  242. (midiport :printer)
  243.  
  244. (compile-instrument-p
  245.  "ccl;output:" "JSB_WK_I_P1-Var"
  246.  rhand lhand1 lhand2)
  247.  
  248.